Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/toolkit/vbof_v11/vbofomgr.cls

Text File | 1996-03-03 | 80KB | 2,550 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VBOFObjectManager"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' VB Object Framework
'   Version 1.0a
'
' (c) Copyright 1995 Ken Fitzpatrick
'     All Rights Reserved
'     Cannot be distributed or sold without permission
'
' Please refer to the attached User's Guide in file
'   "VBOF.doc" for important infomation.
'   Microsoft Word v.6.0 (or later) or equivalent
'   viewer is required.
'
' The VB Object Framework and this demonstration
'   package are provided on an as-is,
'   use-at-your-own-risk basis.
' Even though thorough testing has been performed
'   on this product and demonstration package and
'   every resonable precaution has been taken, the
'   author assumes no responsibilities of any
'   actions or damages which result from the use of
'   this product or demonstration package.
' The above statement is necessary because the very
'   nature of VB Object Framework is to manipulate
'   data in the form of objects.  Under certain
'   circumstances, particularly under situations of
'   misuse or where the user is unfamiliar the
'   product, it would be possible to damage or
'   destroy data.  The author cannot, and will not,
'   be responsible for such use of this product or
'   demonstration package.
'
' To-Do:
'   Coll.Sort: try direct manipulation of
'       object ordering (versus .Remove, .Add)
'   Wrappers.Sort: Sort, then Refresh DisplayOnly:=True
'   DataWrapper: support Validate event
'   Collection.Hide
'   New...Wrapper(Parent:=),
'       TerminateForm
'           delete all Coll where Parent=Form
'   CollectionArray
'   test auto-regist Wrapper, terminate Wrapper
'
' Errors:
'
' Done:
'   Sort
'   Test .Add After:=AnObject
'   Split lines at each parameter of Public methods
'   (ListBoxWrapper.AddItems) Clear:= to pre-Clear
'       the ListBox
'   Availability of an Object:= parameter at every
'       public method where an Item:= parameter is
'       available
'   1.0a
'   Get/Let Properties for AbsolutePosition
'   Full test with errors enabled
'   Identify the Class Module Name which "does not
'       understand" (e.g. "ObjectNewObjectOfMyClass",
'       etc.) in error mesages
'   Not Done (avoiding .Rebind due to invalid state
'       is not informational to the user):
'       Move readiness code from NewVBOF...Wrapper
'           to Wrapper.Rebind
'   Coll: remove need for ObjectLink.CLS
'   Method Form_QueryUnload (Form, Wrappers())
'   RecordSetWrapper: as a subset of the
'       DataWrapper
'   confirm all RegisteredEventObjects are
'       cleaned-up
'   check Object.ObjectDataSource before
'       actually going to the database in
'       OMgr.NewObject
'   Addresses are missing their States, Persons
'       are missing their Mothers and Fathers
'   DBGrid support (remaining Unbound functions)
'   use ListBoxWrappers in DBGrid example
'       (for States, Genders, MaritalStatus)
'   ListBoxWrapper.Rebind
'   OMgr.NewListBoxWrapper: use newLBWrapper.Rebind
'   Clinton's are missing their Address
'   non-Access-specific SQL
'   Add "Set Chelsea.Mother = Hillary" and
'       "Set Chelsea.Father = Bill" to
'       CreateTestData
'   Add "Set Address.State = States.Item(x)" to
'       CreateTestData
'   PopulateCollection
'       RecordSet:=, DB:=,
'       invokes InstantiateFromDB or InstnatiateFromRS
'   NewObject
'       DB:=, SampleObject:=, SQL:=, ObjectID:=,
'       ODBCPassThru:=, NullIfNotFound:=T|F,
'       ANSISQL:=T|F
'   elimiate ListBox:= from Property Get & Sets
'       to be able to remove corresp parm from
'       application calls to Wrapper
'   don't Coll.DetachFromLBWrapper ... would disable
'       support for 1:many (Coll:Wrappers)
'       Figure another way to free the prev Wrapper
'   function to return an instantiated object, given
'       TypeName & ID
'   single copy of StateCodes, MaritalStatus, etc.
'   support Meth=SystemObject(TypeName:=, ObjectID:=)
'   incorp code currently required in methods such
'       as "Persons", "Addresses", etc.
'       (Meth=ManageCollection)
'   Support ODBC Pass Thru
'   Elim redundant "With pvtCurrentPerson : .Name = efName"
'       in demo forms
'   Speed performance by checking for Key=(TypeName)&" "&ObjectID
'       before scanning full SystemObjects
'   (Error) .Replace not deleting link to previous item
'   (Error) .RemoveCollection removes objects prematurely
'       (try the 2 nonDataControl windows, close
'       one, then go after the objects from the other)
'   (Error) Coll.Remove deletes the parent linkage, but
'       that should be persistent
'   added ANSI SQL support (optional)
'   enhanced RecordSet wrapper capability with
'       MoveFirst, MoveLast, FindFirst, FindLast,
'       FindNext, FindPrevious, BOF, EOF
'   CollectionIndex(Where:=FindString)
'   Use-at-your-own-risk message (.txt, in Intro.FRM)
'   propagate code on ListBoxDemo.RefreshCustomerList
'       for dealing with a removed object which had
'       previously been the "pvtCurrent" object
'   Test pvtParentsOfObject()
'   Set (all) tempObject = Nothing
'   Incorp State, MaritalStatus, Gender objects into
'       GUI examples
'   Hold position of CurrentObject in DataControl
'       example
'   Hold position of CurrentObject in DataControl
'       example
'   need to remove item from collection before
'       .TriggerObjectEvent Event=RemovedItem
'       (Trigger between Collections)
'   Finish ListBox example: "Add", "Upd", "Del"
'   Remove references to each object's own EventManager
'   send "Added" trigger to objects which are
'       newly added to the collection
'   send "Instantiated" trigger to objects which
'       are newly instantiated
'   Rename to VBOF for smaller space consumption
'       in the VB Object Browser
'   Support EventManager interface in ObjectManager
'   TriggerCollectionEvent
'   Support #NoEventMgr mode
'   Support #NoDebugMode mode
'   Support ListBox wrapping
'   Support ComboBox wrapping
'   Support UnRegister from EventManager
'   Execute UnRegister Me in GUI Form_QueryUnload()
'   Support .pvtCloseRecordSet
'   AutoDeleteOrphans
'   Implement .Version method
'   ObjMgr.CompleteCleanUp runs too long, redundantly
'
' Deferred until a later release
'   Lock Manager
'       (not yet needed because Collections are still
'       founded on the RecordSet)
'   SynchronousCommit
'       (same as above)
'   Heterogenous Collections
'       see also SubClasses (below)
'   Instantiating SubClasses
'       Do only "Vehicles", won't do "Cars" or "Buses" or "Trucks", etc.
'   Collection.Sort
'   Separated ComboBoxWrapper functions
'   More properties for ODBC, RecordSet, ListBox,
'       ComboBox, DBGrid, etc.

#If NoEventMgr = False Then
Private pvtVBOFEventManager As VBOFEventManager
#End If
Private pvtSystemCollections As New Collection
Private pvtSystemObjects As New Collection
Private pvtSystemWrappers As New Collection
Private pvtDatabase As Database
Private pvtWorkspace As Workspace
Private pvtVBOFCollectionID As Long
Private pvtDebugMode As Boolean
Private pvtVerbose As Boolean
Private pvtAutoDeleteOrphans As Boolean
Private pvtLastAddedObjectWasUnique As Boolean
Private pvtSwapIfEqualSortOrder As Boolean
Private pvtHighestObjectID As Long

Public ODBCPassThrough As Boolean
Public ANSISQL As Boolean

Private Const pvtReceiverDoesNotSupportThisMethod = 438

Public Property Get SwapIfEqualSortOrder() As Boolean
    SwapIfEqualSortOrder = pvtSwapIfEqualSortOrder
End Property

Public Property Let SwapIfEqualSortOrder(aBoolean As Boolean)
    pvtSwapIfEqualSortOrder = aBoolean
End Property


Public Function InitializeObject( _
    Optional Object As Variant) As Boolean
' Initializes the object in support of
'   VBOF services.
'  Even though the contents of this method may seem
'   trivial, it should still be used because future
'   releases of VBOF will likely contained
'   increased features which may have increased
'   initialization requirements.  Only this method
'   is guaranteed to satisfy those requirements.
'   Thus, having used this method from the outset
'   guarantees the user of transparent object
'   initialization support across future releases.
'
' Example of usage:
'   Set MyObject = New <appropriateClassModule>
'   ObjectManager.InitializeObject _
'       Object:=MyObject

    Set Object.ObjectManager = Me

    With Object
        .ObjectParentCount = 1
        .ObjectChanged = False
        .ObjectAdded = False
        .ObjectDeleted = False
    End With

    InitializeObject = True
End Function

Public Function NewObject( _
    Optional Database As Variant, _
    Optional ObjectID As Variant, _
    Optional Sample As Variant, _
    Optional Parent As Variant, _
    Optional WhereClause As Variant, _
    Optional SQL As Variant, _
    Optional OrderByClause As Variant, _
    Optional ODBCPassThrough As Variant, _
    Optional ANSISQL As Variant) As Variant
' Returns an instantiated contained Object which
'   occurs only singly within its container object
'   (versus the container object containing a
'   collection of objects of the specified class).
'   This is typical for contained objects
'   such as Employee.Manager, Address.State,
'   Loan.Property, etc.
'
' Parameter Description:
'   see VBOF User's Guide
'
' Required Parameters:
'   Sample:=
'   ObjectID:=

    Dim tempObject As Object
    Dim tempParent As Object
    Dim tempIndex As Long
    Dim tempRecordSet As RecordSet
    Dim tempODBCPassThrough As Boolean
    Dim SQLStatement As String
    Dim newChildObject As Object
    Dim tempCollectionEmulationMode As Boolean

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Sample) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewObject' method because the 'ObjectID:=' parameter is missing."
        Set NewObject = Nothing
        Exit Function
    End If
    If IsMissing(WhereClause) _
    And IsMissing(ObjectID) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewObject' method because both the 'ObjectID:=' and 'WhereClause:=' parameters are missing."
        Set NewObject = Nothing
        Exit Function
    End If
    tempCollectionEmulationMode = False
    If Sample.ObjectDataSource = "" _
    Or Err = 438 Then
        tempCollectionEmulationMode = True
    End If
    If Not tempCollectionEmulationMode _
    And Not pvtIsDatabaseSpecified() Then
        Set NewObject = Nothing
        Exit Function
    End If
    If IsMissing(ODBCPassThrough) Then
        tempODBCPassThrough = False
    Else
        tempODBCPassThrough = ODBCPassThrough
    End If
    If IsMissing(Parent) Then
        Set tempParent = Nothing
    Else
        Set tempParent = Parent
    End If

' check each of the objects known at this time
'   by their ObjectID
    If Not IsMissing(ObjectID) Then
        If CLng(ObjectID) > 0 Then
            Sample.ObjectID = CLng(ObjectID)
            tempIndex = _
                pvtObjectIndexInSystemObjects _
                    (Object:=Sample)

        ElseIf tempCollectionEmulationMode Then
            tempIndex = -1
'>> huh?
        Else
            Set NewObject = Nothing
            Exit Function
        End If
    Else
        tempIndex = -1
    End If

' if found, return the located object
    If tempIndex > 0 Then
        Set tempObject = _
            pvtSystemObjects.Item _
                (tempIndex)

' increase the ParentCount of the previously
'   existing object
        tempObject.ObjectParentCount = _
            tempObject.ObjectParentCount + 1

        Set NewObject = _
            tempObject
        Exit Function
    End If

' Object wasn't found.
'   try the database
' Ensure the object is ready for Database access
    If tempCollectionEmulationMode Then

' have the Sample Object return an instantiated
'   copy of itself
        Set newChildObject = _
            Me.pvtInstantiateNewObjectFromSample _
                 (Sample:=Sample)
        If newChildObject Is Nothing Then
            Set NewObject = Nothing
            Exit Function
        End If

' assign an artificial ObjectID
        newChildObject.ObjectID = _
            pvtNextObjectID

' add the object to the SystemObjects Collection
        Set NewObject = _
            pvtAddUniqueObject( _
                Object:=newChildObject, _
                Parent:=tempParent)
        Exit Function
    End If

' must retrieve it from the database
    SQLStatement = _
        "SELECT * FROM " & _
        Sample.ObjectDataSource & _
        " WHERE "
    If Not IsMissing(ObjectID) Then
        SQLStatement = _
            SQLStatement & _
                "ObjectID = " & _
                CStr(ObjectID)
    ElseIf Not IsMissing(WhereClause) Then
        SQLStatement = _
            SQLStatement & _
                WhereClause
    End If

' retrieve the data row
    Set tempRecordSet = _
        pvtDatabase. _
            OpenRecordset( _
                SQLStatement, _
                dbOpenDynaset + pvtODBCPassThrough(tempODBCPassThrough))

' check for NoRecords
    If tempRecordSet.RecordCount < 1 Then
        Set NewObject = Nothing
        Exit Function
    End If

' have the Sample Object return an instantiated
'   copy of itself
    Set newChildObject = _
        Me.pvtInstantiateNewObjectFromSample _
             (Sample:=Sample)
    If newChildObject Is Nothing Then
        Set NewObject = Nothing
        Exit Function
    End If

' initialize the NewChild.ObjectID temporarily
'   so the pvtAddUniqueObject will register the
'   correct ObjectID (and avoid an endless loop
'   in the case of SpouseA <-> SpouseB)
    newChildObject.ObjectID = ObjectID

' add the object to the SystemObjects Collection
    Set tempObject = _
        pvtAddUniqueObject( _
            Object:=newChildObject, _
            Parent:=tempParent)

' have the new instantiated object copy populate
'   itself from this RecordSet row
    Set newChildObject = _
        Me.pvtObjectInitializeFromRecordSet( _
            Object:=newChildObject, _
            RecordSet:=tempRecordSet)
    If newChildObject Is Nothing Then
        Set NewObject = Nothing
        Exit Function
    End If

    Set NewObject = _
        tempObject
End Function

Public Function ObjectSortCompare( _
    Optional Value1 As Variant, _
    Optional Value2 As Variant, _
    Optional SortOrder As Variant) As Long
' (In support of the application objects'
'   ObjectSortCompare method)
' Performs a comparison of the two values and
'   returns the value -1, 0 or 1, as needed by the
'   application objects in support of the
'   Collection.Sort method

    Dim tempSortOrder As String

' bullet-proofing
    If IsMissing(Value1) Then
        DisplayErrorMessage TypeName(Me) & " cannot process the '.ObjectSortCompare' method because the 'Value1:=' parameter is missing."
        Exit Function
    End If
    If IsMissing(Value2) Then
        DisplayErrorMessage TypeName(Me) & " cannot process the '.ObjectSortCompare' method because the 'Value2:=' parameter is missing."
        Exit Function
    End If
    If IsMissing(SortOrder) Then
        tempSortOrder = "ASC"
    Else
        tempSortOrder = SortOrder
    End If

' compare the values
    If Value1 < Value2 Then
        ObjectSortCompare = -1
    ElseIf Value1 > Value2 Then
        ObjectSortCompare = 1
    Else
        ObjectSortCompare = 0
    End If

' reverse the answer if processing "DESC"
    If Mid$(tempSortOrder, 1, 1) = "D" Then
        ObjectSortCompare = _
            ObjectSortCompare * -1
    End If
End Function

Public Function pvtChooseObjectIDFromParameters( _
    Optional ObjectID As Variant, _
    Optional Object As Variant, _
    Optional Item As Variant, _
    Optional ReturnObjectID As Variant) As Boolean

    Dim tempObjectRequested As Boolean
    Dim tempObjectID As Variant

    tempObjectRequested = False

' support Object:=, ObjectID:= and Item:=
    If Not IsMissing(ObjectID) Then
        tempObjectID = ObjectID
        tempObjectRequested = True
    ElseIf Not IsMissing(Item) Then
        tempObjectID = Item.ObjectID
        tempObjectRequested = True
    ElseIf Not IsMissing(Object) Then
        tempObjectID = Object.ObjectID
        tempObjectRequested = True
    End If

' if one of the above was specified,
'   save the ObjectID
    If tempObjectRequested Then
        ReturnObjectID = tempObjectID
    End If

    pvtChooseObjectIDFromParameters = _
        tempObjectRequested
End Function

Public Function pvtConvertToLongOrLeaveAlone(Value As Variant) As Variant
    If InStr("Long Integer", TypeName(Value)) > 0 Then
        pvtConvertToLongOrLeaveAlone = CLng(Value)
    Else
        pvtConvertToLongOrLeaveAlone = Value
    End If
End Function

Public Function pvtChooseObjectFromParameters( _
    Optional Object As Variant, _
    Optional Item As Variant, _
    Optional ReturnObject As Variant) As Boolean

    Dim tempObjectRequested As Boolean
    Dim tempObject As Variant

    tempObjectRequested = False

' support Object:= and Item:=
    If Not IsMissing(Item) Then
        If TypeName(Item) = "String" Then
            ReturnObject = Item
            tempObjectRequested = True
        ElseIf TypeName(Item) = "Long" Then
            ReturnObject = Item
            tempObjectRequested = True
        ElseIf TypeName(Item) = "Integer" Then
            ReturnObject = Item
            tempObjectRequested = True
        ElseIf InStr("Nothing Empty", TypeName(Item)) <> 0 Then
            Set ReturnObject = Nothing
            tempObjectRequested = False
        Else
            Set ReturnObject = Item
            tempObjectRequested = True
        End If
    ElseIf Not IsMissing(Object) Then
        Set ReturnObject = Object
        tempObjectRequested = True
    End If

    pvtChooseObjectFromParameters = _
        tempObjectRequested
End Function


Public Function pvtNextObjectID() As Long
        pvtHighestObjectID = _
            pvtHighestObjectID + 1

        If pvtHighestObjectID <= 0 Then
            pvtHighestObjectID = 1
        End If

        pvtSaveHighestObjectID pvtHighestObjectID

        pvtNextObjectID = _
            pvtHighestObjectID
End Function


Public Function pvtObjectInitializeFromRecordSet( _
    Optional Object As Variant, _
    Optional RecordSet As Variant) As Variant

    On Local Error Resume Next

' have the object copy populate
'   itself from this RecordSet row
    Object _
        .ObjectInitializeFromRecordSet (RecordSet)
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(Object) & "' does not support the method 'InitializeFromRecordSet'." & vbCrLf & "Object cannot be supported by VBOF without this method."
        Set pvtObjectInitializeFromRecordSet = Nothing
        Exit Function
    End If

    Set pvtObjectInitializeFromRecordSet = Object
End Function

Public Function pvtInstantiateNewObjectFromSample( _
    Optional Sample As Variant) As Variant

    On Local Error Resume Next

' instantiate the new object
    Set pvtInstantiateNewObjectFromSample = _
        Sample. _
            ObjectNewInstanceOfMyClass
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(Sample) & "' does not support the method 'ObjectNewInstanceOfMyClass'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
        Set pvtInstantiateNewObjectFromSample = Nothing
        Exit Function
    End If

    Set pvtInstantiateNewObjectFromSample. _
        ObjectManager = Me
End Function

Public Function ManageCollection( _
    Optional Collection As Variant, Optional ObjectID As Variant, _
    Optional Item As Variant, Optional Object As Variant, _
    Optional Database As Variant, Optional Sample As Variant, _
    Optional Parent As Variant, Optional WhereClause As Variant, _
    Optional SQL As Variant, Optional OrderByClause As Variant, _
    Optional CollectionEmulationMode As Variant, Optional ANSISQL As Variant, _
    Optional ODBCPassThrough As Variant) As Variant
' Returns the entire collection if the ObjectID
'   parameter is missing,
'   or
' Returns a Person object whose ObjectID matches the
'   ObjectID parameter.
'
' Completely manages a contained Collection of
'   objects on behalf of a given containing object
'
' Example of usage:
'    Public Function Persons(Optional ObjectID As Variant) As Variant
'    Dim tempNewPerson As New Person
'    Set Persons = _
'        ObjectManager. _
'            ManageCollection( _
' (R)            Collection:=myPersonsCollection,
' (R)            Parent:=Me,
' (O)            ObjectID:=ObjectID,
' (O)            Object:=tempObject,
' (O)            Item:=tempObject,
' (O)            Sample:=tempNewPerson,
' (O)            Database:=MyDatabase,
' (O)            SQL:=sql statement,
' (O)            OrderByClause:="LastName ASC, FirstName ASC",
' (O)            WhereClause:=where clause,
' (O)            ANSISQL:=True|False,
' (O)            ODBCPassThrough:=True|False
'
' Parameter Description:
'   Collection:= (Required) the VBOFCollection object
'       to be managed
'   Parent:= (Required) defines the object which is
'       the "Parent" of the objects to be collected.
'       The value to specify is typically "Me".
'       In OO terminology, this is the "containing"
'       object
'   Database:= (Optional) the VB Database Object containing
'       the necessary Table
'   ObjectID:= (Optional) the ObjectID value of the
'       desired object.  If not provided, the entire
'       VBOFCollection is returned
'   Item:= (Optional) can be used in lieu of the
'       ObjectID:= parameter.  Refers to the object
'       to be returned.  See also the ObjectID:=
'       parameter.
'   Object:= (Optional) can be used in lieu of the
'       ObjectID:= parameter.  Refers to the object
'       to be returned.  See also the ObjectID:=
'       parameter.
'   Sample:= (Optional, but recommended) a
'       throw-away object of the desired Class which
'       VBOFCollection can use to help instantiate
'       new objects to be placed into the
'       Collection
'   WhereClause:= (Optional) defines the SQL Where
'       Clause to be used to select the desired
'       rows from the Table.
'       Normally, VBOFCollection creates all
'       necessary Where Clauses to effect containment
'   SQL:= (Optional, not recommended) defines the
'       SQL statement to be used to select the
'       desired rows from the Table.
'       Normally, VBOFCollection creates the
'       necessary SQL statement to effect containment
'   OrderByClause:= (Optional) defines the SQL Order
'       By Clause to be used to select the desired
'       rows from the Table.
'       Normally, VBOFCollection does not provide an
'       Order By Clause
'   ANSISQL:= (Optional) control whether or not
'       ANSI SQL should be used when linking objects
'       for containment purposes
'   ODBCPassThrough:= (Optional) controls whether
'       of not the SQL statements used by
'       VBOFCollection to link parent and child objects
'       should be executed on an ODBC database server

    Dim tempDatabase As Database
    Dim tempObjectRequested As Boolean
    Dim tempObjectID As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Collection) _
    Or IsMissing(Parent) _
    Or IsMissing(Sample) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.ManageCollection' method because either the 'Collection:=', 'Parent:=' or 'Sample:=' parameter is missing."
        Set ManageCollection = Nothing
        Exit Function
    End If

' use a valid Database parameter
    If Not IsMissing(Database) Then
        Set tempDatabase = Database
    Else
        Set tempDatabase = pvtDatabase
    End If

' check for never-before referenced Collection
    If Collection Is Nothing Then
        Set Collection = _
            ObjectManager.NewVBOFCollection _
                (Parent:=Parent)
    End If

' check for the need to populate the collection
'   from the database
    If Not Collection. _
            pvtDatabaseHasBeenReferenced Then

' pass-along any known Database parameters
        Collection.SetDatabaseParameters _
            Database:=tempDatabase, _
            SQL:=SQL, _
            ANSISQL:=ANSISQL, _
            WhereClause:=WhereClause, _
            OrderByClause:=OrderByClause, _
            ODBCPassThrough:=ODBCPassThrough

' instantiate the contained objects
        Set Collection = _
            Collection.PopulateCollection( _
                Database:=tempDatabase, _
                Parent:=Parent, _
                Sample:=Sample)
    End If

' check for a request for a specific Object
    If pvtChooseObjectIDFromParameters( _
        Item:=Item, _
        Object:=Object, _
        ObjectID:=ObjectID, _
        ReturnObjectID:=tempObjectID) _
    Then
        Set ManageCollection = _
            Collection.Item _
                (pvtConvertToLongOrLeaveAlone _
                    (tempObjectID))
'>>        If InStr("Long Integer", TypeName(tempObjectID)) > 0 Then
'            Set ManageCollection = _
                Collection.Item _
                    (tempObjectID)
'        Else
'            Set ManageCollection = _
                Collection.Item _
                    (ObjectID:=CStr(tempObjectID))
'        End If

' else, return the entire collection
    Else
        Set ManageCollection = _
            Collection
    End If
End Function

Private Function pvtRegisterWrapperUnderForm( _
    Optional Form As Variant, _
    Optional Wrapper As Variant) As Boolean
' NOT CURRENTLY SUPPORTED
' register the wrapper for future automatic
'   deletion as the Form terminates (through
'   TerminateForm)

    On Local Error Resume Next

    If Not IsMissing(Form) Then
        If Not Form Is Nothing Then
            pvtSystemWrappers.Add _
                Item:=Wrapper, _
                Key:=CStr(Wrapper.ObjectID)

            Set Wrapper.Form = _
                Form
        End If
    End If

    pvtRegisterWrapperUnderForm = True
End Function

Public Sub pvtSaveHighestObjectID( _
    Optional ObjectID As Variant)
    If ObjectID > pvtHighestObjectID Then
        pvtHighestObjectID = ObjectID
    End If
End Sub

Public Function pvtUnRegisterWrapperUnderForm( _
    Optional Form As Variant, _
    Optional Wrapper As Variant) As Boolean
' NOT CURRENTLY SUPPORTED
' unregister the wrapper from the Form

    Dim tempWrapper As Variant

    On Local Error Resume Next

    pvtUnRegisterWrapperUnderForm = False

' bullet-proofing
    If IsMissing(Form) Then
        Exit Function
    ElseIf Form Is Nothing Then
        Exit Function
    ElseIf IsMissing(Wrapper) Then
        Exit Function
    ElseIf Wrapper Is Nothing Then
        Exit Function
    End If

' search for the wrapper
    For Each tempWrapper In pvtSystemWrappers

' unregister it
        If tempWrapper.ObjectID = Wrapper.ObjectID Then
            Set tempWrapper.Form = Nothing

            pvtSystemWrappers.Remove _
                CStr(tempWrapper.ObjectID)

            pvtUnRegisterWrapperUnderForm = True
            Exit Function
        End If
    Next tempWrapper
End Function

Public Function pvtWrapperSort( _
    Optional Wrapper As Variant, _
    Optional SortField As Variant, _
    Optional SortOrder As Variant) As Boolean

    Dim tempBoolean As Boolean

    tempBoolean = _
        Wrapper.Collection.Sort( _
            SortField:=SortField, _
            SortOrder:=SortOrder)

    If Not tempBoolean Then
        pvtWrapperSort = False
        Exit Function
    End If

    Wrapper.Refresh _
        DisplayOnly:=True

    pvtWrapperSort = True
End Function

Public Function pvtWrapperUseCollection( _
    Optional CollectionParm As Variant, _
    Optional pvtCollection As Variant, _
    Optional Verbose As Variant, _
    Optional WrapperName As Variant) As Variant

    On Local Error Resume Next

    If Not IsMissing(CollectionParm) Then
        If Not CollectionParm Is Nothing Then
            If TypeName(CollectionParm) = _
                "VBOFCollection" _
            Then
                Set pvtCollection = CollectionParm
                Set pvtWrapperUseCollection = pvtCollection
                Exit Function
            End If
        End If
    End If

    If Not IsMissing(pvtCollection) Then
        If Not pvtCollection Is Nothing Then
            If TypeName(pvtCollection) = _
                "VBOFCollection" _
            Then
                Set pvtWrapperUseCollection = pvtCollection
                Exit Function
            End If
        End If
    End If

' error
    If Not IsMissing(Verbose) Then
        If Verbose Then
            pvtErrorMessage TypeName(Me) & " cannot process the " & WrapperName & " methods because the 'Collection' parameter is missing and no suitable default has been established." & vbCrLf & vbCrLf & "If using the VBOF" & WrapperName & "Wrapper, please ensure that the 'ObjectManager.NewVBOF" & WrapperName & "Wrapper' method has been properly executed and references the appropriate Collection and " & WrapperName & " control."
        End If
    End If

    Set pvtWrapperUseCollection = Nothing
End Function

Public Function pvtWrapperUseControl( _
    Optional ControlParm As Variant, _
    Optional pvtControl As Variant, _
    Optional SupportedNames As Variant, _
    Optional WrapperName As Variant, _
    Optional Verbose As Variant) As Variant

    On Local Error Resume Next

    If Not IsMissing(ControlParm) Then
        If Not ControlParm Is Nothing Then
            If InStr(SupportedNames, TypeName(ControlParm)) > 0 Then
                Set pvtControl = ControlParm
                Set pvtWrapperUseControl = pvtControl
                Exit Function
            End If
        End If
    End If

    If Not IsMissing(pvtControl) Then
        If Not pvtControl Is Nothing Then
            If InStr(SupportedNames, TypeName(pvtControl)) > 0 Then
                Set pvtWrapperUseControl = pvtControl
                Exit Function
            End If
        End If
    End If

' error
    If Not IsMissing(Verbose) Then
        If Verbose Then
            pvtErrorMessage TypeName(Me) & " cannot process the " & WrapperName & " methods because the '" & WrapperName & "' parameter is missing and no suitable default has been established." & vbCrLf & vbCrLf & "If using the VBOF" & WrapperName & "Wrapper, please ensure that the 'ObjectManager.NewVBOF" & WrapperName & "Wrapper' method has been properly executed and references the appropriate Collection and " & WrapperName & " control."
        End If
    End If

    Set pvtWrapperUseControl = Nothing
End Function

Public Function pvtWrapperVerifyCollection( _
    Optional Collection As Variant, _
    Optional pvtCollection As Variant, _
    Optional Verbose As Variant, _
    Optional WrapperName As Variant) As Boolean

    Dim tempCollection As Variant

    If Not IsMissing(Collection) Then
        Set tempCollection = Collection
    Else
        Set tempCollection = pvtCollection
    End If

    If pvtWrapperUseCollection( _
        CollectionParm:=tempCollection, _
        pvtCollection:=pvtCollection, _
        Verbose:=Verbose, _
        WrapperName:=WrapperName) Is Nothing _
    Then
        pvtWrapperVerifyCollection = False
    Else
        pvtWrapperVerifyCollection = True
    End If
End Function

Public Function pvtWrapperVerifyControl( _
    Optional Control As Variant, _
    Optional pvtControl As Variant, _
    Optional Verbose As Variant, _
    Optional WrapperName As Variant) As Boolean

    Dim tempControl As Variant

    If Not IsMissing(Control) Then
        Set tempControl = Control
    Else
        Set tempControl = pvtControl
    End If

    If pvtWrapperUseControl( _
        ControlParm:=tempControl, _
        pvtControl:=pvtControl, _
        Verbose:=Verbose, _
        WrapperName:=WrapperName) Is Nothing _
    Then
        pvtWrapperVerifyControl = False
    Else
        pvtWrapperVerifyControl = True
    End If
End Function


Public Function NewVBOFRecordSetWrapper( _
    Optional Collection As Variant, _
    Optional DataControl As Variant, _
    Optional Form As Variant _
    ) As VBOFDataWrapper
' Returns a new VBOFRecordSetlWrapper for the
'   specified VBOFCollection
'
' Coding Example:
'   Dim MyRecordSetWrapper as VBOFRecordSetWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyRecordSetWrapper = _
'       ObjectManager.NewVBOFRecordSetWrapper ( _
'           Collection:=MyCollection)

    Dim tempNewRecordSetWrapper As New VBOFRecordSetWrapper

    Set tempNewRecordSetWrapper.ObjectManager = Me

' bullet-proofing
'    If IsMissing(Collection) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFRecordSetWrapper' method because the 'Collection:=' parameter is missing."
'        Set NewVBOFRecordSetWrapper = Nothing
'        Exit Function
'    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewRecordSetWrapper.Collection = _
                Collection
        End If
    End If

' have the new wrapper bind itself to the RecordSet
    If Not tempNewRecordSetWrapper.Collection Is Nothing Then
        tempNewRecordSetWrapper.Rebind
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewRecordSetWrapper.ObjectID = _
        pvtVBOFCollectionID

' register the wrapper for future automatic
'   deletion as the Form terminates (through
'   TerminateForm)
'    pvtRegisterWrapperUnderForm _
        Form:=Form, _
        Wrapper:=tempNewRecordSetWrapper

    Set NewVBOFRecordSetWrapper = _
        tempNewRecordSetWrapper
End Function

Public Function NewVBOFDBGridWrapper( _
    Optional Collection As Variant, _
    Optional DBGrid As Variant, _
    Optional Form As Variant _
    ) As VBOFDBGridWrapper
' Returns a new VBOFDBGridWrapper for the
'   specified VBOFCollection (Required) and
'   DBGrid (Optional)
'
' Coding Example:
'   Dim MyDBGridWrapper as VBOFDBGridWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyDBGridWrapper = _
'       ObjectManager.NewVBOFDBGridWrapper ( _
'           Collection:=MyCollection, _
'           DBGrid:=MyDBGrid)

    Dim tempNewDBGridWrapper As New VBOFDBGridWrapper

    Set tempNewDBGridWrapper.ObjectManager = Me

' bullet-proofing
'    If IsMissing(Collection) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDBGridWrapper' method because the 'Collection:=' parameter is missing."
'        Set NewVBOFDBGridWrapper = Nothing
'        Exit Function
'    End If
'    If IsMissing(DBGrid) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDBGridWrapper' method because the 'DBGrid:=' parameter is missing."
'        Set NewVBOFDBGridWrapper = Nothing
'        Exit Function
'    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewDBGridWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(DBGrid) Then
        If Not DBGrid Is Nothing Then
            Set tempNewDBGridWrapper.DBGrid = _
                DBGrid
        End If
    End If

' have the new wrapper bind itself to the DBGrid
    If Not tempNewDBGridWrapper.DBGrid Is Nothing Then
        If Not tempNewDBGridWrapper.Collection Is Nothing Then
            tempNewDBGridWrapper.Rebind _
                Collection:=Collection, _
                DBGrid:=DBGrid
        End If
    End If

' generate a unique ObjectID for the new VBOFDBGridWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewDBGridWrapper.ObjectID = _
        pvtVBOFCollectionID

' register the wrapper for future automatic
'   deletion as the Form terminates (through
'   TerminateForm)
'    pvtRegisterWrapperUnderForm _
        Form:=Form, _
        Wrapper:=tempNewDBGridWrapper

    Set NewVBOFDBGridWrapper = _
        tempNewDBGridWrapper
End Function

Private Function pvtIsDatabaseSpecified() As Integer
' Determine whether or not the database has been
'   specified

    If pvtDatabase Is Nothing Then
'        pvtErrorMessage TypeName(Me) & " cannot function without having been provided the name of the database.  Use the 'Database:=' parameter to specify the database."
        pvtIsDatabaseSpecified = False
        Exit Function
    End If

    pvtIsDatabaseSpecified = True
End Function


Public Function Collection( _
    Optional ObjectID As Variant, _
    Optional Index As Variant) As VBOFCollection
' Return the VBOFCollection having the specified
'   ObjectID or Index

    On Local Error Resume Next

    Set Collection = Nothing

' bullet-proofing
    If IsMissing(ObjectID) And IsMissing(Index) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Collection' method because the 'ObjectID:=' and the 'Index:=' parameters were missing."
        Exit Function
    End If

    If Not IsMissing(Index) Then
        Set Collection = _
            pvtSystemCollections(Index)

    ElseIf Not IsMissing(ObjectID) Then
        Set Collection = _
            pvtSystemCollections(CStr(ObjectID))
    End If

End Function

Public Function CompleteObjectCleanUp() As Boolean
Attribute CompleteObjectCleanUp.VB_Description = "Private"
' Removes all known Collections and Objects from the
'   current environment
' Note: does NOT sever the automatic object
'   containment links between containing objects and
'   contained objects

    Dim tempCollection As VBOFCollection

    On Local Error Resume Next

    For Each tempCollection In pvtSystemCollections

        RemoveCollection _
            Collection:=tempCollection, _
            NoDelete:=True, _
            CleanUpMode:=True

        pvtSystemCollections.Remove 1

    Next tempCollection

    CompleteObjectCleanUp = True
End Function

Public Function DisplayDebugMessage( _
    Optional Message As Variant) As Long

#If NoDebugMode = False Then
    DisplayDebugMessage = True

    If Not pvtDebugMode Then
        Exit Function
    End If

    Debug.Print Format$(Now, "yyyy/mm/dd hh:nn:ss") & " " & Message
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .DisplayDebugMessage method has been executed, but the conditional compilation parameter 'NoDebugMode = -1' has been specified.  No Event code is generated unless 'NoDebugMode = 0' or 'NoDebugMode' is missing from the conditional compilation string altogether."
    End If
#End If
End Function


Public Function NewVBOFListBoxWrapper( _
    Optional Collection As Variant, _
    Optional ListBox As Variant, _
    Optional Form As Variant _
    ) As VBOFListBoxWrapper
' Returns a new VBOFListBoxWrapper for the
'   specified VBOFCollection (Required) and
'   ListBox (Optional)
'
' Coding Example:
'   Dim MyListBoxWrapper as VBOFListBoxWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyListBoxWrapper = _
'       ObjectManager.NewVBOFListBoxWrapper ( _
'           Collection:=MyCollection, _
'           ListBox:=MyListBox)

    Dim tempNewListBoxWrapper As New VBOFListBoxWrapper

    Set tempNewListBoxWrapper.ObjectManager = Me

' bullet-proofing
'    If IsMissing(Collection) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFListBoxWrapper' method because the 'Collection:=' parameter is missing."
'        Set NewVBOFListBoxWrapper = Nothing
'        Exit Function
'    End If
'    If IsMissing(ListBox) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFListBoxWrapper' method because the 'ListBox:=' parameter is missing."
'        Set NewVBOFListBoxWrapper = Nothing
'        Exit Function
'    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewListBoxWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(ListBox) Then
        If Not ListBox Is Nothing Then
            Set tempNewListBoxWrapper.ListBox = _
                ListBox
        End If
    End If

' have the new wrapper bind itself to the ListBox
    If Not tempNewListBoxWrapper.ListBox Is Nothing Then
        If Not tempNewListBoxWrapper.Collection Is Nothing Then
            tempNewListBoxWrapper.Rebind _
                Collection:=Collection, _
                ListBox:=ListBox
        End If
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewListBoxWrapper.ObjectID = _
        pvtVBOFCollectionID

' register the wrapper for future automatic
'   deletion as the Form terminates (through
'   TerminateForm)
'    pvtRegisterWrapperUnderForm _
        Form:=Form, _
        Wrapper:=tempNewListBoxWrapper

    Set NewVBOFListBoxWrapper = _
        tempNewListBoxWrapper
End Function

Public Function NewVBOFDataWrapper( _
    Optional Collection As Variant, _
    Optional DataControl As Variant, _
    Optional Form As Variant _
    ) As VBOFDataWrapper
' Returns a new VBOFDataWrapper for the
'   specified VBOFCollection, and optionally the
'   DataControl
'
' Coding Example:
'   Dim MyDataWrapper as VBOFDataWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyDataWrapper = _
'       ObjectManager.NewVBOFDataWrapper ( _
'           Collection:=MyCollection)
' or
'   Set MyDataWrapper = _
'       ObjectManager.NewVBOFDataWrapper ( _
'           Collection:=MyCollection, _
'           DataControl:=MyDataControl)

    Dim tempNewDataWrapper As New VBOFDataWrapper

    Set tempNewDataWrapper.ObjectManager = Me

' bullet-proofing
'    If IsMissing(Collection) Then
'        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDataWrapper' method because the 'Collection:=' parameter is missing."
'        Set NewVBOFDataWrapper = Nothing
'        Exit Function
'    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewDataWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(DataControl) Then
        If Not DataControl Is Nothing Then
            Set tempNewDataWrapper.DataControl = _
                DataControl
        End If
    End If

' have the new wrapper bind itself to the DataControl
    If Not tempNewDataWrapper.DataControl Is Nothing Then
        If Not tempNewDataWrapper.Collection Is Nothing Then
            tempNewDataWrapper.Rebind _
                Collection:=Collection, _
                DataControl:=DataControl
        End If
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewDataWrapper.ObjectID = _
        pvtVBOFCollectionID

' register the wrapper for future automatic
'   deletion as the Form terminates (through
'   TerminateForm)
'    pvtRegisterWrapperUnderForm _
        Form:=Form, _
        Wrapper:=tempNewDataWrapper

    Set NewVBOFDataWrapper = _
        tempNewDataWrapper
End Function

Public Property Get pvtObjectWasUnique() As Boolean
Attribute pvtObjectWasUnique.VB_Description = "Private"
    pvtObjectWasUnique = pvtLastAddedObjectWasUnique
End Property

Public Function pvtParentsOfObject( _
    Optional Object As Variant) As Collection
' Returns a Collection of VBOFCollections which
'   are Parents of Object.
' Note: knowledge of an Object's parents is not
'   considered good object-oriented technique

    Dim tempVBOFCollection As VBOFCollection
    Dim tempCollection As New Collection
    Dim I As Long

' process each VBOFCollection
    I = 1
    For Each tempVBOFCollection In pvtSystemCollections

' process each object therein
        If pvtObjectIndexInCollection( _
            Object:=Object, _
            Collection:=tempVBOFCollection) > 0 _
        Then
            tempCollection.Add _
                Item:=tempVBOFCollection, _
                Key:=CStr(I)

            I = I + 1
        End If

    Next tempVBOFCollection

    Set pvtParentsOfObject = tempCollection
End Function

Private Function pvtObjectIndexInCollection( _
    Optional Object As Variant, _
    Optional Collection As Variant) As Long
' Returns the index of the Object within the
'   Collection

    Dim tempObject As Object
    Dim I As Long

' check each of the Objects defined to the
'   Collection
    I = 0
    For I = 1 To Collection.Count
        Set tempObject = Collection.Item(I)

' return the Collection's index position
        If TypeName(tempObject) = TypeName(Object) Then
            If tempObject.ObjectID = Object.ObjectID Then
                pvtObjectIndexInCollection = I
                Exit Function
            End If
        End If
    Next I

    pvtObjectIndexInCollection = -1
End Function

Private Function pvtObjectParent( _
    Optional Object As Variant) As VBOFCollection
' Returns the first VBOFCollection found
'   to contain Object

    Dim tempVBOFCollection As VBOFCollection
    Dim tempObject As Object

' process each VBOFCollection
    For Each tempVBOFCollection In pvtSystemCollections

' process each object therein
        If pvtObjectIndexInCollection( _
            Object:=Object, _
            Collection:=tempVBOFCollection) > 0 _
        Then
            Set pvtObjectParent = tempVBOFCollection
            Exit Function
        End If
    Next tempVBOFCollection

' didn't find an Parent
    Set pvtObjectParent = Nothing
End Function

Private Function pvtODBCPassThrough(ODBCPassThrough As Boolean) As Long

    If ODBCPassThrough Then
        pvtODBCPassThrough = dbSQLPassThrough
    Else
        pvtODBCPassThrough = 0
    End If
End Function

Public Function RegisterForObjectEvent( _
    Optional TriggerObject As Variant, _
    Optional TriggerObjectType As Variant, _
    Optional TriggerEvent As Variant, _
    Optional RegisterObject As Variant, _
    Optional RegisterType As Variant) As Boolean
' Pass-through to the EventManager

#If NoEventMgr = False Then
    RegisterForObjectEvent = _
        pvtVBOFEventManager.RegisterForObjectEvent( _
            TriggerObject:=TriggerObject, _
            TriggerObjectType:=TriggerObjectType, _
            TriggerEvent:=TriggerEvent, _
            RegisterObject:=RegisterObject, _
            RegisterType:=RegisterType)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .RegisterForObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    RegisterForObjectEvent = True
End Function

Public Function RegisterForCollectionEvent( _
    Optional Collection As Variant, _
    Optional RegisterObject As Variant, _
    Optional TriggerEvent As Variant) As Boolean
' Pass-through to the EventManager

#If NoEventMgr = False Then
    RegisterForCollectionEvent = _
        pvtVBOFEventManager.RegisterForCollectionEvent( _
            Collection:=Collection, _
            TriggerEvent:=TriggerEvent, _
            RegisterObject:=RegisterObject)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .RegisterForCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    RegisterForCollectionEvent = True
End Function


Public Function RemoveCollection( _
    Optional Collection As Variant, _
    Optional NoDelete As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' Remove the Collection and its contents
'
' Note: refer to the value of CleanUpMode to
'   determine whether or not the automatic object
'   containment links between containing objects and
'   contained objects will be severed

    On Local Error Resume Next

    Collection.pvtCloseRecordSet

    EmptyCollection _
        Collection:=Collection, _
        NoDelete:=NoDelete, _
        CleanUpMode:=CleanUpMode

    UnRegisterForAllEvents _
        RegisterObject:=Collection, _
        CleanUpMode:=CleanUpMode

    Set Collection = Nothing

    RemoveCollection = True
End Function


Public Function RemoveWrapper( _
    ParamArray WrapperCollection())
' Removes Wrapper(s) in an orderly manner.
'
' Note: See also method "Form_QueryUnload"

    Dim I As Long

    On Local Error Resume Next

    For I = 0 To UBound(WrapperCollection)
        If InStr(TypeName(WrapperCollection(I)), "Wrapper") > 0 Then
            WrapperCollection(I).Unbind

            Me.TerminateObject _
               WrapperCollection(I)
        End If

        Set WrapperCollection(I) = Nothing
    Next I
End Function


Public Function SystemObject( _
    Optional TypeName As Variant, _
    Optional ObjectID As Variant) As Variant
' Returns an Object from the pvtSystemObjects
'   collection whose TypeName matches TypeName
'   and whose ObjectID matches ObjectID
' Note: in most cases, the results of this method
'   and the use thereof is not considered good
'   object-oriented behavior

    Dim tempObject As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(TypeName) _
    Or IsMissing(ObjectID) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.SystemObject' method because either the 'TypeName:=' or 'ObjectID:=' parameter is missing."
        Set SystemObject = Nothing
        Exit Function
    End If

' find the desired object and return ir
    For Each tempObject In pvtSystemObjects
        If TypeName(tempObject) = TypeName Then
            If tempObject.ObjectID = ObjectID Then
                Set SystemObject = tempObject
                Exit Function
            End If
        End If

    Next tempObject

    Set SystemObject = Nothing
End Function

Public Property Get SystemObjects() As Collection
Attribute SystemObjects.VB_Description = "Private"
' Returns a Collection (that's the VB4 Collection
'   object, not the VBOFCollection object)
'   which contains a reference to each object
'   currently being managed by VBOFObjectManager

    Set SystemObjects = pvtSystemObjects
End Property

Public Property Get SystemCollections() As Collection
Attribute SystemCollections.VB_Description = "Private"
' Returns a Collection (that's the VB4 Collection
'   object, not the VBOFCollection object)
'   which contains a reference to each
'   VBOFCollection currently being managed by
'   VBOFObjectManager

    Set SystemCollections = pvtSystemCollections
End Property

Private Function pvtIsExactlyTheSameObject( _
    Optional Object1 As Variant, _
    Optional Object2 As Variant) As Boolean
' Determines whether two objects are exactly the
'   same.
' Note: this is a kind of kludge, but necessary
'   because VB doesn't return pointers to the objects

    Dim tempObjectID As Long

' test by changing one, then checking the other
    tempObjectID = Object1.ObjectID
    Object1.ObjectID = -1
    If Object2.ObjectID = -1 Then
        pvtIsExactlyTheSameObject = True
    Else
        pvtIsExactlyTheSameObject = False
    End If

' reinstate the previous value
    Object1.ObjectID = tempObjectID
End Function

Public Function RemoveObject( _
    Optional Object As Variant, _
    Optional Parent As Variant, _
    Optional Collection As Variant, _
    Optional NoDelete As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' Remove the Object from the specified Parent.
'   Delete the Object if its ParentCount = 0
' Note: if a Table is supporting the Collection
'   then the VBOF automatic containment link to
'   the contained object (Collection.Parent) is also
'   severed (unless CleanUpMode:=True)

    Dim tempIndex As Long
    Dim tempParent As VBOFCollection
    Dim tempNoDelete As Boolean
    Dim tempCleanUpMode As Boolean

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Object) And IsMissing(Parent) And IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.RemoveObject' method for this object because either the 'Object:=', 'Collection:=' or the 'Parent:=' parameter is missing"
        RemoveObject = False
        Exit Function
    End If
    If Object.ObjectID < 0 Then
        RemoveObject = False
        Exit Function
    End If

    If IsMissing(NoDelete) Then
        tempNoDelete = False
    Else
        tempNoDelete = NoDelete
    End If

    If IsMissing(CleanUpMode) Then
        tempCleanUpMode = False
    Else
        tempCleanUpMode = CleanUpMode
    End If

' if the Parent:= is missing, find the first Parent
'   Note: herein, a Parent is an VBOFCollection
    If Not IsMissing(Parent) Then
        Set tempParent = Parent
    ElseIf Not IsMissing(Collection) Then
        Set tempParent = Collection
    Else
        Set tempParent = _
            pvtObjectParent(Object)
    End If

' remove event registrations
#If NoEventMgr = False Then
    UnRegisterForAllEvents _
        RegisterObject:=Object, _
        CleanUpMode:=CleanUpMode
#End If

' schedule orphans to be deleted
    If tempParent Is Nothing Then
        Object.ObjectParentCount = 0
    End If

' if there's only 1 Parent (or less)
    If pvtParentsOfObject(Object).Count <= 1 Then

' remove the Object from the specified Parent,
'   and delete it according to NoDelete
        If Not tempParent Is Nothing Then
            tempParent.Remove _
                Item:=Object, _
                NoDelete:=tempNoDelete, _
                CleanUpMode:=CleanUpMode
        End If

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveObject' has removed the ObjectType=" & _
                TypeName(Object) & _
                ", ObjectID=" & _
                Object.ObjectID
        End If
#End If

' free the Object
        pvtFreeObject _
            Object:=Object

        RemoveObject = True
        Exit Function

' remove the Object from the specified Parent,
'   but don't delete it
    Else
        Parent.Remove _
            Item:=Object, _
            NoDelete:=True, _
            CleanUpMode:=CleanUpMode

' drop Object's ParentCount by 1
        Object.ObjectParentCount = _
            Object.ObjectParentCount - 1

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveObject' has decremented the ObjectParentCount to " & Object.ObjectParentCount & " for ObjectType=" & _
                TypeName(Object) & _
                ", ObjectID=" & _
                Object.ObjectID
        End If
#End If

        RemoveObject = True
        Exit Function
    End If
End Function

Private Function pvtErrorMessage( _
    Optional ErrorMessage As Variant) As Long
    pvtErrorMessage = _
        DisplayErrorMessage(ErrorMessage)
End Function


Private Function pvtObjectIndexInSystemObjects( _
    Optional Object As Variant) As Long
' Return the Index of Object in the collection
'   of system objects

    Dim tempObject As Object
    Dim I As Long

    On Local Error Resume Next

' quick-check to see if the object exists
    Set tempObject = _
        pvtSystemObjects(TypeName(Object) & " " & _
        CStr(Object.ObjectID))
    If Err = 5 Then
        pvtObjectIndexInSystemObjects = -1
        Exit Function
    End If

' the object likely exists in the SystemObjects.
'   find its Index.

' check each of the objects known at this time
    I = 0
    For Each tempObject In pvtSystemObjects
        I = I + 1

' return the collection's index position
        If TypeName(tempObject) = TypeName(Object) Then
            If tempObject.ObjectID = Object.ObjectID Then
                pvtObjectIndexInSystemObjects = I
                Exit Function
            End If
        End If
    Next tempObject

 ' return "not found"
    pvtObjectIndexInSystemObjects = -1
    Exit Function
End Function


Public Function pvtAddUniqueObject(Optional Object As Variant, Optional Parent As Variant) As Variant
Attribute pvtAddUniqueObject.VB_Description = "(Private) Ensures no duplicate instances of a given object exist"
' Return a system-wide unique object which is the
'   Item, or an already existing, functionally
'   equivalent of the Item
' Note: this method, while public, is designed to be
'   invoked only by the .Add method of an instance
'   of VBOFCollection.  Any other use must make
'   allowances for Object to have been freed and
'   replaced by an equivalent object which was
'   found to have already existed under the control
'   of VBOFObjectManager

    Dim tempObject As Object
    Dim tempIndex As Long

    On Local Error Resume Next
    pvtLastAddedObjectWasUnique = False

' bullet-proofing
    If IsMissing(Object) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtAddUniqueObject' method for this object because the 'Object:=' parameter is missing"
        pvtAddUniqueObject = False
        Exit Function
    End If

' initialize all objects that pass through here,
'   in support of VBOF services
    Set Object.ObjectManager = _
        Me

' check each of the objects known at this time
    tempIndex = _
        pvtObjectIndexInSystemObjects _
            (Object:=Object)

' if found, return the located object
    If tempIndex > 0 Then
        Set tempObject = _
            pvtSystemObjects.Item _
                (tempIndex)

' if these are exactly the same object
        If pvtIsExactlyTheSameObject( _
            Object1:=Object, _
            Object2:=tempObject) _
        Then

' increase the ParentCount of the previously
'   existing object
            Object.ObjectParentCount = _
                Object.ObjectParentCount + 1

#If NoDebugMode = False Then
            If DebugMode Then
                DisplayDebugMessage _
                    TypeName(Me) & " 'Add Object' attempt found exact same (already existing) Object.  ObjectType=" & _
                    TypeName(Object) & _
                    ", ObjectID=" & _
                    Object.ObjectID
            End If
#End If

        Else
' else, free the Object (the parameter)
            Object.ObjectID = -1
            Set Object = Nothing
        End If

' return the located object
        Set pvtAddUniqueObject = _
            pvtSystemObjects.Item _
                (tempIndex)

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'Add Object' attempt found an existing Object.  ObjectType=" & _
                TypeName(Object) & _
                ", ObjectID=" & _
                Object.ObjectID
        End If
#End If

        GoTo pvtAddUniqueObject_Exit
    End If

' else, the object is unique
'   add the object to the collection of system objects
    pvtSystemObjects.Add _
        Item:=Object, _
        Key:=TypeName(Object) & " " & CStr(Object.ObjectID)

' mark the object as "Added"
    Object.ObjectAdded = True

' trigger the "Instantiated" event for the new object
#If NoEventMgr = False Then
    TriggerObjectEvent _
        Event:="Instantiated", _
        Object:=Object
#End If

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'Add Object' attempt did not find any existing Object.  The Object was added, ObjectType=" & _
            TypeName(Object) & _
            ", ObjectID=" & _
            Object.ObjectID
    End If
#End If

' initialize the new object in support of
'   VBOF services
    InitializeObject _
        Object:=Object

' return the original object
    Set pvtAddUniqueObject = Object
    pvtLastAddedObjectWasUnique = True

pvtAddUniqueObject_Exit:
    Set tempObject = Nothing
End Function

Public Function DisplayErrorMessage( _
    Optional ErrorMessage As Variant) As Long

    Dim RC As Long

    If Err <> 0 Then
        RC = MsgBox( _
            ErrorMessage & vbCrLf & "Err=" & Err & ", Msg=" & Error(Err) & _
            vbCrLf & "Version=" & Version & ", Date=" & VersionDate, _
            vbOK + vbExclamation, _
            TypeName(Me) & " Run-Time Message")
    Else
        RC = MsgBox( _
            ErrorMessage & _
            vbCrLf & "Version=" & Version, _
            vbOK + vbExclamation, _
            TypeName(Me) & " Run-Time Message")
    End If

    Err = 0
    DisplayErrorMessage = RC
End Function


Public Property Get ObjectManager() As VBOFObjectManager
Attribute ObjectManager.VB_Description = "Private"
    Set ObjectManager = Me
End Property




Public Property Get ObjectID() As Long
Attribute ObjectID.VB_Description = "Private"
    ObjectID = -1
End Property



Public Function NewVBOFCollection( _
    Optional Database As Variant, _
    Optional Parent As Variant, _
    Optional Owner As Variant) As VBOFCollection
'  Return a new, properly instantiated
'   VBOFCollection object

    Dim tempVBOFCollection As New VBOFCollection

    On Local Error Resume Next

' generate a unique ObjectID for the new VBOFCollection
    pvtVBOFCollectionID = pvtVBOFCollectionID + 1

' initialize
    Set tempVBOFCollection.ObjectManager = Me
    With tempVBOFCollection
        .ObjectID = pvtVBOFCollectionID
        .AutoDeleteOrphans = Me.AutoDeleteOrphans
        .SwapIfEqualSortOrder = Me.SwapIfEqualSortOrder
    End With

' set any known parameters
    If Not IsMissing(Database) Then
        Set pvtDatabase = Database
    End If
    If Not IsMissing(Owner) Then
        Set tempVBOFCollection.Parent = Owner
    End If
    If Not IsMissing(Parent) Then
        Set tempVBOFCollection.Parent = Parent
    End If

' pass-along any known database parms
    tempVBOFCollection.SetDatabaseParameters _
        ODBCPassThrough:=ODBCPassThrough, _
        ANSISQL:=ANSISQL, _
        Database:=pvtDatabase

' add the new VBOFCollection to the
'   system-wide collection of
'   VBOFCollections, for object management
'   purposes
    pvtSystemCollections.Add _
        Item:=tempVBOFCollection

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'NewVBOFCollection' completed, new ObjectID=" & _
            tempVBOFCollection.ObjectID
    End If
#End If

    Set NewVBOFCollection = tempVBOFCollection
End Function


Public Sub Form_QueryUnload( _
    Form As Variant, _
    ParamArray WrapperCollection())
' Cleans-up while a Form is being Unloaded
'
' Programming Example:
'   Private Sub Form_QueryUnload(...)
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.Form_QueryUnload _
'               Me, _
'               MyListBoxWrapper, _
'               MyListBoxOtherWrapper, _
'               MyDBGridWrapper, _
'               MyDBGridOtherWrapper, _
'               . . .
'       End If

    Dim tempWrapper As Variant
    Dim tempWrapperArray(1 To 1) As Variant

    On Local Error Resume Next

' remove event registrations
#If NoEventMgr = False Then
    UnRegisterForAllEvents _
        RegisterObject:=Form, _
        CleanUpMode:=False
#End If

' clear the registered Wrappers for the Form
    For Each tempWrapper In pvtSystemWrappers
        If TypeName(tempWrapper.Form) = _
            TypeName(Form) _
        Then
            Set tempWrapperArray(1) = _
                tempWrapper

            Me.RemoveWrapper _
                tempWrapperArray()

' unregister the Wrapper from the Form
            pvtUnRegisterWrapperUnderForm _
                Form:=Form, _
                Wrapper:=tempWrapper
        End If

    Next tempWrapper

' clear the requested wrappers
    Me.RemoveWrapper _
        WrapperCollection()

End Sub

Public Function TerminateForm(Form As Variant, ParamArray WrapperCollection())
Attribute TerminateForm.VB_Description = "Private"
' Cleans-up while a Form is being Unloaded.
'
' Note:  This is the equivalent of the method
'   "Form_QueryUnload" but this method's name
'   might be easier for the programmer to remember,
'   given that there is a method named
'   "TerminateObject", as well, used for
'   terminating objects
'
' Programming Example:
'   Private Sub Form_QueryUnload(...)
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.TerminateForm _
'               Me, _
'               MyListBoxWrapper, _
'               MyListBoxOtherWrapper, _
'               MyDBGridWrapper, _
'               MyDBGridOtherWrapper, _
'               . . .
'       End If

    Me.Form_QueryUnload _
        Form, _
        WrapperCollection()

End Function


Public Function TerminateObject( _
    Object As Variant) As Boolean
' Cleans-up while an object is being terminated.
'
' Programming Example:
'   Private Sub Class_Terminate()
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.TerminateObject _
'               Object:=Me
'       End If

    Me.RemoveObject _
        Object:=Object, _
        NoDelete:=True, _
        CleanUpMode:=False

End Function

Public Function TriggerObjectEvent( _
    Optional Event As Variant, _
    Optional Object As Variant, _
    Optional Verbose As Variant) As Boolean
' Pass-through to the EventManager

#If NoEventMgr = False Then
    TriggerObjectEvent = _
        pvtVBOFEventManager.TriggerObjectEvent( _
            Event:=Event, _
            Object:=Object, _
            Verbose:=Verbose)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .TriggerObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    TriggerObjectEvent = True
End Function

Public Function TriggerCollectionEvent( _
    Optional Event As Variant, _
    Optional Object As Variant, _
    Optional Collection As Variant, _
    Optional Verbose As Variant, _
    Optional NoDelete As Variant) As Boolean
' Pass-through to the EventManager

#If NoEventMgr = False Then
    pvtVBOFEventManager.TriggerCollectionEvent _
        Event:=Event, _
        Object:=Object, _
        Collection:=Collection, _
        Verbose:=Verbose, _
        NoDelete:=NoDelete
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .TriggerCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    TriggerCollectionEvent = True
End Function


Public Function UnRegisterForAllEvents( _
    Optional RegisterObject As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' Unregisters the UnregisterObject from all
'   events
'   (a wrapper method for
'       Me.UnRegisterForCollectionEvent and
'       Me.UnRegisterForObjectEvent

    Dim tempCleanUpMode As Boolean

    If IsMissing(CleanUpMode) Then
        tempCleanUpMode = False
    Else
        tempCleanUpMode = CleanUpMode
    End If

#If NoEventMgr = False Then
    Me.UnRegisterForCollectionEvent _
        RegisterObject:=RegisterObject, _
        CleanUpMode:=tempCleanUpMode

    Me.UnRegisterForObjectEvent _
        RegisterObject:=RegisterObject, _
        CleanUpMode:=tempCleanUpMode
#End If
End Function

Public Function UnRegisterForObjectEvent( _
    Optional RegisterObject As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' UnRegister the Object for Events

' don't bother doing this during "CleanUpMode"
'   because ObjectManager is being killed, anyway
    If Not IsMissing(CleanUpMode) Then
        If CleanUpMode Then
            UnRegisterForObjectEvent = True
            Exit Function
        End If
    End If

#If NoEventMgr = False Then
    If Not pvtVBOFEventManager Is Nothing Then
        pvtVBOFEventManager.UnRegisterForObjectEvent _
            RegisterObject:=RegisterObject
    End If
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .UnRegisterForObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    UnRegisterForObjectEvent = True
End Function


Public Property Get Version() As String
Attribute Version.VB_Description = "Returns the current version of VBOF"
    Version = "1.1"
End Property

Public Property Get VersionDate() As String
Attribute VersionDate.VB_Description = "Returns the current version date of VBOF"
    VersionDate = "1996-03-03"
End Property


Private Sub Class_Initialize()

#If NoEventMgr = False Then
    Set pvtVBOFEventManager = _
        New VBOFEventManager
    Set pvtVBOFEventManager.ObjectManager = _
        Me
#End If

    Set pvtDatabase = Nothing

'    pvtSynchronousCommit = False
    pvtDebugMode = False
    pvtVerbose = False
    AutoDeleteOrphans = False
    pvtLastAddedObjectWasUnique = False
    pvtVBOFCollectionID = 0
    pvtHighestObjectID = 0
    ANSISQL = False
    ODBCPassThrough = False

End Sub

Public Property Get ObjectEventManager() As Variant
Attribute ObjectEventManager.VB_Description = "Private"
' Returns my pvtEventManager

#If NoEventMgr = False Then
    Set ObjectEventManager = pvtVBOFEventManager
#Else
    Set ObjectEventManager = Nothing
#End If
End Property

Private Function pvtFreeObject( _
    Optional Object As Variant, _
    Optional Index As Variant) As Boolean
' Free the Object and remove it from the collection
'   of known system objects

    On Local Error Resume Next

    If Not IsMissing(Index) Then
        pvtSystemObjects.Remove Index
    Else
        pvtSystemObjects.Remove _
            pvtObjectIndexInSystemObjects(Object:=Object)
    End If

    Set Object = Nothing
    pvtFreeObject = True
End Function



Private Function pvtCommitObjects() As Boolean
' NOT CURRENTLY SUPPORTED
'
' Coordinates a synchronous database Commit across
'   all currently instantiated objects.
' Returns True or False, depending on whether or not
'   the Commit was successful (False means that a
'   Rollback has been issued)
' Note: requires use of SynchronousCommit:=True
'   in a parameter to VBOFObjectManager

    Dim tempVBOFCollection As VBOFCollection

' bullet-proofing
    If pvtSynchronousCommit = False Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.CommitObjects' method because the 'SynchronousCommit' environment does not exist.  Execute 'ObjectManager.SynchronousCommit = True'to establish the correct environment."
        pvtCommitObjects = False
        Exit Function
    End If

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " Starting 'CommitObjects' processing."
    End If
#End If

' start the transaction
    pvtWorkspace.BeginTrans

' process each VBOFCollection
    For Each tempVBOFCollection In pvtSystemCollections

' have each commit
        If Not tempVBOFCollection.Commit Then
            pvtWorkspace.Rollback
            pvtCommitObjects = False
            Exit Function
        End If
    Next tempVBOFCollection

' commit the transaction
    pvtWorkspace.CommitTrans

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'CommitObjects' finished successfully."
    End If
#End If

    pvtCommitObjects = True
    Exit Function
End Function

Public Property Set Database(aDatabase As Database)
Attribute Database.VB_Description = "Sets the Database property"
    Set pvtDatabase = aDatabase

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'Database' set to " & TypeName(aDatabase)
    End If
#End If

End Property

Public Property Get Database() As Database
    Set Database = pvtDatabase
End Property


Public Property Get Workspace() As Workspace
Attribute Workspace.VB_Description = "Maps to the Workspace property"
    Set Workspace = pvtWorkspace
End Property

Public Property Set Workspace(aWorkspace As Workspace)
    Set pvtWorkspace = aWorkspace
End Property

Public Function EmptyCollection( _
    Optional Collection As Variant, _
    Optional NoDelete As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' Empty the VBOFCollection of all its Objects.
'
' Note: if a DataSource is supporting the Collection
'   then the VBOF automatic containment links to
'   the contained objects are also severed

    Dim tempIndex As Long
    Dim tempVBOFCollection As VBOFCollection
    Dim tempObject As Object
    Dim I As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.EmptyCollection' method for this object because the 'Collection:=' parameter is missing"
        EmptyCollection = False
        Exit Function
    End If

' free all of its referenced Objects
    For I = 1 To Collection.Count

        Set tempObject = Collection.Item(1)

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveCollection' is removing the Collection.ObjectID=" & _
                tempObject.ObjectID
        End If
#End If

        RemoveObject _
            Object:=tempObject, _
            Parent:=Collection, _
            NoDelete:=NoDelete, _
            CleanUpMode:=CleanUpMode

    Next I

    EmptyCollection = True
End Function

Public Property Let DebugMode(aBoolean As Boolean)
Attribute DebugMode.VB_Description = "Maps to the DebugMode property"
    pvtDebugMode = aBoolean

#If NoDebugMode = False Then
    If pvtDebugMode Then
        DisplayDebugMessage TypeName(Me) & " starting debug mode"
    End If
#Else
    If aBoolean Then
        DisplayErrorMessage TypeName(Me) & " (Warning) DebugMode has been requested, but the conditional compilation parameter 'NoDebugMode = -1' has been specified.  No debug code is generated unless 'NoDebugMode = 0' or 'NoDebug' is missing from the conditional compilation string altogether."
    End If
#End If
End Property

Public Property Get DebugMode() As Boolean
    DebugMode = pvtDebugMode
End Property


Public Property Get Verbose() As Boolean
Attribute Verbose.VB_Description = "Maps to the Verbose property"
    Verbose = pvtVerbose
End Property
Public Property Let Verbose(aBoolean As Boolean)
    pvtVerbose = aBoolean
End Property


Private Property Get pvtSynchronousCommit()
' NOT CURRENTLY SUPPORTED
'
' Return the current state of the
'   SynchronousCommit environment (True or False)

'    SynchronousCommit = pvtSynchronousCommit
End Property

Private Property Let pvtSynchronousCommit(aBoolean)
' NOT CURRENTLY SUPPORTED
'
' Set the SynchronousCommit environment to aBoolean

'#If NoDebugMode = False Then
'    If DebugMode Then
'        DisplayDebugMessage _
'            TypeName(Me) & " 'SynchronousCommit' mode has been set to " & aBoolean
'    End If
'#End If

'    pvtSynchronousCommit = aBoolean
End Property

Public Function UnRegisterForCollectionEvent( _
    Optional RegisterObject As Variant, _
    Optional CleanUpMode As Variant) As Boolean
' UnRegister the Collection for Events

' don't bother doing this during "CleanUpMode",
'   because ObjectManager is being killed, anyway
    If Not IsMissing(CleanUpMode) Then
        If CleanUpMode Then
            UnRegisterForCollectionEvent = True
            Exit Function
        End If
    End If

#If NoEventMgr = False Then
    If Not pvtVBOFEventManager Is Nothing Then
        pvtVBOFEventManager.UnRegisterForCollectionEvent _
            RegisterObject:=RegisterObject, _
            CleanUpMode:=CleanUpMode
    End If
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .UnRegisterForCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    UnRegisterForCollectionEvent = True
End Function



Public Property Get AutoDeleteOrphans() As Boolean
Attribute AutoDeleteOrphans.VB_Description = "Maps to the AutoDeleteOrphans property"
    AutoDeleteOrphans = pvtAutoDeleteOrphans
End Property

Public Property Let AutoDeleteOrphans(aBoolean As Boolean)
    pvtAutoDeleteOrphans = aBoolean
End Property




Private Sub Class_Terminate()
#If NoEventMgr = False Then
    Set pvtVBOFEventManager = Nothing
#End If

    Set pvtSystemCollections = Nothing
    Set pvtSystemObjects = Nothing
End Sub